home *** CD-ROM | disk | FTP | other *** search
/ Programming Languages Suite / ProgramD2.iso / Visual Database / Visual Foxpro 6.0 (Ent. Edition) / Vf6ent Extractor.EXE / TOOLS / XSOURCE / XSOURCE.ZIP / vfpsource / Browser / vfpscrpt.prg < prev    next >
Encoding:
Text File  |  1998-05-01  |  19.3 KB  |  675 lines
  1. * VFPScrpt.prg
  2. *
  3. *-- ASCII codes
  4. #DEFINE    EOB        CHR(0)
  5. #DEFINE    MARKER    CHR(1)
  6. #DEFINE    TAB        CHR(9)
  7. #DEFINE    LF        CHR(10)
  8. #DEFINE    CR        CHR(13)
  9. #DEFINE CR_LF    CR+LF
  10.  
  11. *-- Strings
  12. #DEFINE    VFPS_SCRIPT_START    '<SCRIPT LANGUAGE="VFPS">'
  13. #DEFINE    VFPS_SCRIPT_START2    '<SCRIPT LANGUAGE="VFPScript">'
  14. #DEFINE    VFPS_SCRIPT_START3    '<SCRIPT LANGUAGE=VFPS>'
  15. #DEFINE    VFPS_SCRIPT_START4    '<SCRIPT LANGUAGE=VFPScript>'
  16. #DEFINE    VBS_SCRIPT_START    '<SCRIPT LANGUAGE="VBS">'
  17. #DEFINE SCRIPT_END            "</SCRIPT>"
  18. #DEFINE    VFPS_FUNCTION_START    "FUNCTION"
  19. #DEFINE    VFPS_FUNCTION_END    "ENDFUNC"
  20. #DEFINE    VBS_FUNCTION_START    "Sub"
  21. #DEFINE    VBS_FUNCTION_END    "End Sub"
  22.  
  23.  
  24.  
  25. LPARAMETERS toWebBrowser
  26.  
  27. RETURN HTMLX(toWebBrowser)
  28.  
  29.  
  30.  
  31. FUNCTION HTMLX(toWebBrowser)
  32. PRIVATE pcSourceText,pcNewSourceText,pcAppendSourceText,pcRefreshData,pcRefreshSource
  33. LOCAL lcVFPScript,lcFilePath,lcFileName,lnLastSelect
  34. LOCAL lcMainScriptCode,lcScriptCode,lcScript,llBusy
  35. LOCAL lcMemLine,lnCount,lnAtPos,lnAtPos1,lnAtPos2
  36.  
  37. IF TYPE("toWebBrowser")#"O" OR ISNULL(toWebBrowser)
  38.     RETURN .F.
  39. ENDIF
  40. WITH toWebBrowser
  41.     llBusy=.lBusy
  42.     .SetBusyState(.T.)
  43.     .OpenVFPScript
  44.     .RunScript("OnUnLoad")
  45.     .nScriptCount=0
  46.     DIMENSION .aScripts[1,3]
  47.     .aScripts=""
  48. ENDWITH
  49. lnLastSelect=SELECT()
  50. CREATE CURSOR tempHTMLfile (Source M)
  51. APPEND BLANK
  52. APPEND MEMO Source FROM (toWebBrowser.cSourceFileName) OVERWRITE
  53. pcSourceText=ALLTRIM(Source)
  54. USE
  55. IF NOT LEFT(pcSourceText,1)=="CR"
  56.     pcSourceText=CR+pcSourceText
  57. ENDIF
  58. IF NOT RIGHT(pcSourceText,1)=="CR"
  59.     pcSourceText=pcSourceText+CR_LF
  60. ENDIF
  61. pcNewSourceText=pcSourceText
  62. pcAppendSourceText=""
  63. pcRefreshData=""
  64. pcRefreshSource=""
  65. DO WHILE .T.
  66.     IF toWebBrowser.lRelease
  67.         EXIT
  68.     ENDIF
  69.     lcVFPScript=""
  70.     pcNewSourceText=StrTranC(pcNewSourceText,VFPS_SCRIPT_START2, ;
  71.             VFPS_SCRIPT_START)
  72.     pcNewSourceText=StrTranC(pcNewSourceText,VFPS_SCRIPT_START3, ;
  73.             VFPS_SCRIPT_START)
  74.     pcNewSourceText=StrTranC(pcNewSourceText,VFPS_SCRIPT_START4, ;
  75.             VFPS_SCRIPT_START)
  76.     lnAtPos1=ATC(VFPS_SCRIPT_START,pcNewSourceText)
  77.     IF lnAtPos1=0
  78.         pcNewSourceText=EvlTxt(pcNewSourceText)
  79.         IF NOT EMPTY(pcAppendSourceText)
  80.             IF toWebBrowser.lDebug
  81.                 pcAppendSourceText=toWebBrowser.EditString(pcAppendSourceText)
  82.             ENDIF
  83.             pcNewSourceText=pcNewSourceText+pcAppendSourceText
  84.             pcAppendSourceText=""
  85.             LOOP
  86.         ENDIF
  87.         EXIT
  88.     ENDIF
  89.     lnAtPos2=ATC(SCRIPT_END,SUBSTR(pcNewSourceText,lnAtPos1))
  90.     IF lnAtPos2=0
  91.         EXIT
  92.     ENDIF
  93.     lcVFPScript=SUBSTR(pcNewSourceText,lnAtPos1+LEN(VFPS_SCRIPT_START), ;
  94.             lnAtPos2-LEN(VFPS_SCRIPT_START)-1)
  95.     IF NOT EMPTY(pcAppendSourceText)
  96.         IF toWebBrowser.lDebug
  97.             pcAppendSourceText=toWebBrowser.EditString(pcAppendSourceText)
  98.         ENDIF
  99.         lcVFPScript=lcVFPScript+pcAppendSourceText
  100.         pcAppendSourceText=""
  101.     ENDIF
  102.     IF NOT EMPTY(pcRefreshData)
  103.         pcRefreshData=VFPS_SCRIPT_START+CR_LF+ ;
  104.                 VFPS_FUNCTION_START+[ RefreshData]+CR_LF+ ;
  105.                 [IF TYPE("oTHIS.document.script")#"O"]+CR_LF+ ;
  106.                 [    RETURN]+CR_LF+ ;
  107.                 [ENDIF]+CR_LF+ ;
  108.                 [SET DATASESSION TO (oTHIS.nDataSessionID)]+CR_LF+ ;
  109.                 EvlTxt(pcRefreshData)+CR_LF+;
  110.                 [SET DATASESSION TO (oTHIS.oHost.DataSessionID)]+CR_LF+ ;
  111.                 VFPS_FUNCTION_END+CR_LF+CR_LF+ ;
  112.                 VFPS_FUNCTION_START+[ RefreshSource]+CR_LF+ ;
  113.                 [IF TYPE("oTHIS.document.script")#"O"]+CR_LF+ ;
  114.                 [    RETURN]+CR_LF+ ;
  115.                 [ENDIF]+CR_LF+ ;
  116.                 [SET DATASESSION TO (oTHIS.nDataSessionID)]+CR_LF+ ;
  117.                 EvlTxt(pcRefreshSource)+CR_LF+;
  118.                 [SET DATASESSION TO (oTHIS.oHost.DataSessionID)]+CR_LF+ ;
  119.                 VFPS_FUNCTION_END+CR_LF+ ;
  120.                 SCRIPT_END+CR_LF
  121.         IF toWebBrowser.lDebug
  122.             pcRefreshData=toWebBrowser.EditString(pcRefreshData)
  123.         ENDIF
  124.         pcNewSourceText=pcNewSourceText+pcRefreshData
  125.         pcRefreshData=""
  126.     ENDIF
  127.     pcNewSourceText=LEFT(pcNewSourceText,lnAtPos1-1)+ ;
  128.             SUBSTR(pcNewSourceText,lnAtPos1+lnAtPos2+LEN(SCRIPT_END))
  129.     IF EMPTY(lcVFPScript)
  130.         LOOP
  131.     ENDIF
  132.     lcMainScriptCode=""
  133.     lcScriptCode=""
  134.     lcScript=""
  135.     _mline=0
  136.     FOR lnCount = 1 TO MEMLINES(lcVFPScript)
  137.         lcMemLine=MLINE(lcVFPScript,1,_mline)
  138.         IF UPPER(LEFT(lcMemLine,LEN(VFPS_FUNCTION_START)))==VFPS_FUNCTION_START
  139.             IF EMPTY(lcMainScriptCode)
  140.                 lcMainScriptCode=lcScriptCode
  141.             ENDIF
  142.             lcScriptCode=""
  143.             lnAtPos=AT(" ",lcMemLine)
  144.             lcScript=IIF(lnAtPos=0,LOWER(SYS(2015)),ALLTRIM(SUBSTR(lcMemLine,lnAtPos+1)))
  145.             LOOP
  146.         ENDIF
  147.         IF UPPER(LEFT(lcMemLine,LEN(VFPS_FUNCTION_END)))==VFPS_FUNCTION_END
  148.             WITH toWebBrowser
  149.                 .nScriptCount=.nScriptCount+1
  150.                 DIMENSION .aScripts[.nScriptCount,3]
  151.                 .aScripts[.nScriptCount,1]=lcScript
  152.                 .aScripts[.nScriptCount,2]=EvlTxt(lcScriptCode)
  153.                 .aScripts[.nScriptCount,3]=lcScriptCode
  154.             ENDWITH
  155.             lcScript=""
  156.             lcScriptCode=""
  157.             LOOP
  158.         ENDIF
  159.         lcScriptCode=lcScriptCode+lcMemLine+CR_LF
  160.     ENDFOR
  161.     IF EMPTY(lcMainScriptCode) AND EMPTY(lcScript)
  162.         lcMainScriptCode=EvlTxt(lcScriptCode)
  163.     ENDIF
  164.     IF NOT EMPTY(lcMainScriptCode)
  165.         toWebBrowser.RunCode(lcMainScriptCode)
  166.     ENDIF
  167.     lcVFPScript=""
  168. ENDDO
  169. pcNewSourceText=EvlTxt(pcNewSourceText)
  170. IF NOT EMPTY(pcAppendSourceText)
  171.     IF toWebBrowser.lDebug
  172.         pcAppendSourceText=toWebBrowser.EditString(pcAppendSourceText)
  173.     ENDIF
  174.     pcNewSourceText=pcNewSourceText+pcAppendSourceText
  175.     pcAppendSourceText=""
  176. ENDIF
  177. IF toWebBrowser.lRelease OR pcNewSourceText==pcSourceText
  178.     SELECT (lnLastSelect)
  179.     toWebBrowser.SetBusyState(llBusy)
  180.     RETURN .F.
  181. ENDIF
  182. CREATE CURSOR (toWebBrowser.cTempFilePrefix+LOWER(SYS(2015))) (Text M)
  183. INSERT BLANK
  184. REPLACE Text WITH pcNewSourceText
  185. IF NOT toWebBrowser.lRefreshMode
  186.     toWebBrowser.EraseTempFile
  187.     lcFilePath=LOWER(toWebBrowser.TrimFile(toWebBrowser.cSourceFileName))
  188.     lnAtPos1=RAT(":",lcFilePath)
  189.     IF lnAtPos1>2
  190.         lcFilePath=ALLTRIM(SUBSTR(lcFilePath,lnAtPos1-1))
  191.     ENDIF
  192.     lcFileName=lcFilePath+toWebBrowser.cTempFilePrefix+LOWER(SYS(2015))+".htm"
  193.     toWebBrowser.cTempFileName=lcFileName
  194. ENDIF
  195. COPY MEMO Text TO (toWebBrowser.cTempFileName)
  196. USE
  197. SELECT (lnLastSelect)
  198. toWebBrowser.SetBusyState(llBusy)
  199. RETURN
  200.  
  201.  
  202.  
  203. FUNCTION EvlTxt(tcText)
  204. LOCAL lcNewText,lcEvalStr,lcEvalStr1,lcEvalStr2,lcVarType
  205. LOCAL lnAtPos,lnAtPos2,lnAtPos3,lnAtPos4,lnAtPos5,lnAtLine
  206. LOCAL lnCount,lnCount2,llEvlMode,lcMethod,lcOldStr,lcNewStr
  207. LOCAL lcName,lcFunction,lcClauses,lcControlName,lcControlSource
  208. LOCAL lcDataValue,lcLabel,lnLastRecNo,lnRecNo,lcRecNo,llAddSize,lcSize
  209. LOCAL lcEvent,lcHTMLControlSource,llInputTag,llCheckBox,lcAlias
  210. LOCAL lnAtPos,lnAtPos2,lcInputTag,lcVFPCode,lcCode,lcMemVar
  211.  
  212. IF oTHIS.lRelease
  213.     RETURN ""
  214. ENDIF
  215. SET DATASESSION TO (oTHIS.nDataSessionID)
  216. m.lcNewText=m.tcText
  217. m.lnAtPos3=1
  218. DO WHILE .T.
  219.     m.lnAtPos=AT("{{",SUBSTR(m.tcText,m.lnAtPos3))
  220.     IF m.lnAtPos=0
  221.         EXIT
  222.     ENDIF
  223.     m.lnAtPos2=AT("}}",SUBSTR(m.tcText,m.lnAtPos+m.lnAtPos3-1))
  224.     IF m.lnAtPos2=0
  225.         EXIT
  226.     ENDIF
  227.     m.lnAtPos4=AT("{{",SUBSTR(m.tcText,m.lnAtPos+m.lnAtPos3+1))
  228.     IF m.lnAtPos4>0 AND m.lnAtPos4<m.lnAtPos2
  229.         m.lnAtPos4=OCCURS("{{",SUBSTR(m.tcText,m.lnAtPos+m.lnAtPos3-1,;
  230.                 m.lnAtPos2-m.lnAtPos4))
  231.         m.lnAtPos4=AT("{{",SUBSTR(m.tcText,m.lnAtPos+m.lnAtPos3-1),m.lnAtPos4)
  232.         m.lcOldStr=SUBSTR(m.tcText,m.lnAtPos+m.lnAtPos3-1,m.lnAtPos2+1)
  233.         m.lcEvalStr=SUBSTR(m.lcOldStr,3,LEN(m.lcOldStr)-2)
  234.         m.lcOldStr=EvlTxt(m.lcEvalStr)
  235.         m.tcText=STRTRAN(m.tcText,m.lcEvalStr,m.lcOldStr)
  236.         m.lcNewText=STRTRAN(m.lcNewText,m.lcEvalStr,m.lcOldStr)
  237.         LOOP
  238.     ENDIF
  239.     m.lcOldStr=SUBSTR(m.tcText,m.lnAtPos+m.lnAtPos3-1,m.lnAtPos2+1)
  240.     m.lcEvalStr=ALLTRIM(SUBSTR(m.lcOldStr,3,LEN(m.lcOldStr)-4))
  241.     m.llEvlMode=.F.
  242.     DO CASE
  243.         CASE EMPTY(m.lcEvalStr)
  244.             m.lcEvalStr=""
  245.         CASE LEFT(m.lcEvalStr,2)=="&."
  246.             m.lcEvalStr=SUBSTR(m.lcEvalStr,3)
  247.             &lcEvalStr &&;
  248.             Error occured during macro substitution of {{&. <expC> }}.
  249.             m.lcEvalStr=""
  250.         CASE LEFT(m.lcEvalStr,2)=="*:"
  251.             m.lcEvalStr=UPPER(ALLTRIM(SUBSTR(m.lcEvalStr,3)))
  252.             DO CASE
  253.                 CASE m.lcEvalStr=="DEBUG"
  254.                     oTHIS.lDebug=.T.
  255.                 CASE m.lcEvalStr=="NODEBUG"
  256.                     oTHIS.lDebug=.F.
  257.                 CASE m.lcEvalStr=="DESIGN"
  258.                     oTHIS.lDesign=.T.
  259.                 CASE m.lcEvalStr=="NODESIGN"
  260.                     oTHIS.lDesign=.F.
  261.             ENDCASE
  262.             RETURN ""
  263.         CASE LEFT(m.lcEvalStr,2)=="<:"
  264.             lcName=SUBSTR(m.lcEvalStr,3)
  265.             lcAlias=""
  266.             lnAtPos=AT("::",lcName)
  267.             IF lnAtPos>0
  268.                 lcAlias=ALLTRIM(LEFT(lcName,lnAtPos-1))
  269.                 lcName=ALLTRIM(SUBSTR(lcName,lnAtPos+2))
  270.             ENDIF
  271.             m.lcEvalStr=oTHIS.GetHTML(lcName,lcAlias) &&;
  272.             Error occured during evaluation of {{<: <expC> }}.
  273.         CASE LEFT(m.lcEvalStr,1)=="<"
  274.             m.lcEvalStr=InsFile(SUBSTR(m.lcEvalStr,2)) &&;
  275.             Error occured during evaluation of {{< <file> }}.
  276.         CASE LEFT(m.lcEvalStr,1)==">"
  277.             lcName=SUBSTR(m.lcEvalStr,2)
  278.             oTHIS.uReturn=""
  279.             oTHIS.VFPS(oTHIS.cVFPSProtocol+"RunScript?"+lcName) &&;
  280.             Error occured during RunScript of {{> <expC> }}.
  281.             m.lcEvalStr=oTHIS.uReturn
  282.         CASE LEFT(m.lcEvalStr,1)=="@"
  283.             m.lcEvalStr=SUBSTR(m.lcEvalStr,2)
  284.             lnAtPos=AT(",",m.lcEvalStr)
  285.             IF lnAtPos=0
  286.                 RETURN ""
  287.             ENDIF
  288.             lcLabel=SUBSTR(m.lcEvalStr,lnAtPos+1)
  289.             lcClauses=ALLTRIM(LEFT(m.lcEvalStr,lnAtPos-1))
  290.             llInputTag=(UPPER(LEFT(lcClauses,5))=="INPUT")
  291.             lcControlSource=""
  292.             lcEvent=""
  293.             lcCode=""
  294.             lnAtPos=AT(",",lcLabel)
  295.             IF lnAtPos>0
  296.                 lcControlSource=ALLTRIM(SUBSTR(lcLabel,lnAtPos+1))
  297.                 lcLabel=ALLTRIM(LEFT(lcLabel,lnAtPos-1))
  298.                 lnAtPos=AT(",",lcControlSource)
  299.                 IF lnAtPos>0
  300.                     lnAtPos2=AT("]",lcControlSource)
  301.                     IF lnAtPos2=0
  302.                         lnAtPos2=AT(")",lcControlSource)
  303.                     ENDIF
  304.                     IF BETWEEN(lnAtPos,1,lnAtPos2)
  305.                         lnAtPos=AT(",",lcControlSource,2)
  306.                     ENDIF
  307.                 ENDIF
  308.                 IF lnAtPos>0
  309.                     lcEvent=ALLTRIM(SUBSTR(lcControlSource,lnAtPos+1))
  310.                     lcControlSource=ALLTRIM(LEFT(lcControlSource,lnAtPos-1))
  311.                     lnAtPos=AT(",",lcEvent)
  312.                     IF lnAtPos>0
  313.                         lcCode=ALLTRIM(SUBSTR(lcEvent,lnAtPos+1))
  314.                         lcEvent=ALLTRIM(LEFT(lcEvent,lnAtPos-1))
  315.                      ENDIF
  316.                  ENDIF
  317.             ENDIF
  318.             IF EMPTY(lcControlSource)
  319.                 RETURN ""
  320.             ENDIF
  321.             lcMemVar=""
  322.             lnAtPos=AT("=",lcControlSource)
  323.             IF lnAtPos>0
  324.                 lcMemVar=ALLTRIM(LEFT(lcControlSource,lnAtPos-1))
  325.                 lcControlSource=ALLTRIM(SUBSTR(lcControlSource,lnAtPos+1))
  326.                 IF EMPTY(lcMemVar)
  327.                     lcMemVar="pu"+LOWER(LOWER(SYS(2015)))
  328.                 ENDIF
  329.             ENDIF
  330.             lcRecNo=""
  331.             lnAtPos=AT("@",lcControlSource)
  332.             IF lnAtPos>0
  333.                 lcRecNo=ALLTRIM(SUBSTR(lcControlSource,lnAtPos+1))
  334.                 lcControlSource=ALLTRIM(LEFT(lcControlSource,lnAtPos-1))
  335.             ENDIF
  336.             lcAlias=""
  337.             lnAtPos=AT("->",lcControlSource)
  338.             IF lnAtPos>0
  339.                 lcAlias=ALLTRIM(LEFT(lcControlSource,lnAtPos-1))
  340.                 lcControlSource=ALLTRIM(SUBSTR(lcControlSource,lnAtPos+2))
  341.             ELSE
  342.                 lnAtPos=AT(".",lcControlSource)
  343.                 IF lnAtPos>0
  344.                     lcAlias=ALLTRIM(LEFT(lcControlSource,lnAtPos-1))
  345.                 ENDIF
  346.             ENDIF
  347.             IF EMPTY(lcAlias) OR VAL(lcRecNo)=0
  348.                 lcRecNo=""
  349.             ENDIF
  350.             IF NOT EMPTY(lcAlias) AND USED(lcAlias)
  351.                 IF EOF(lcAlias)
  352.                     GO BOTTOM IN (lcAlias)
  353.                 ENDIF
  354.                 IF EMPTY(lcRecNo)
  355.                     oTHIS.nRecNo=RECNO(lcAlias)
  356.                     lcRecNo=[IIF(oTHIS.nRecNo>0,oTHIS.nRecNo,RECNO("]+lcAlias+["))]
  357.                 ENDIF
  358.             ELSE
  359.                 lcRecNo=""
  360.             ENDIF
  361.             IF NOT EMPTY(lcRecNo)
  362.                 lnLastRecNo=RECNO(lcAlias)
  363.                 lnRecNo=EVALUATE(lcRecNo)
  364.                 GO lnRecNo IN (lcAlias)
  365.             ELSE
  366.                 lnLastRecNo=0
  367.             ENDIF
  368.             m.lcEvalStr=lcControlSource
  369.             m.lcEvalStr=EVALUATE(m.lcEvalStr) &&;
  370.             Error occured during evaluation of {{ <expC> }}.
  371.             IF lnLastRecNo>0
  372.                 GO lnLastRecNo IN (lcAlias)
  373.             ENDIF
  374.             m.lcVarType=TYPE("m.lcEvalStr")
  375.             lcControlName=""
  376.             lnAtPos=ATC("NAME=",lcClauses)
  377.             IF lnAtPos>0
  378.                 lcControlName=ALLTRIM(SUBSTR(lcClauses,lnAtPos+6))
  379.             ELSE
  380.                 lnAtPos=ATC("NAME =",lcClauses)
  381.                 IF lnAtPos>0
  382.                     lcControlName=ALLTRIM(SUBSTR(lcClauses,lnAtPos+7))
  383.                 ENDIF
  384.             ENDIF
  385.             IF EMPTY(lcControlName)
  386.                 lcControlName="ctl"+LOWER(SYS(2015))
  387.                  lcClauses=lcClauses+[ NAME="]+lcControlName+["]
  388.             ELSE
  389.                 IF INLIST(LEFT(lcControlName,1),["],['],[ ],[,])
  390.                     lcControlName=ALLTRIM(SUBSTR(lcControlName,2))
  391.                 ENDIF
  392.                 lnAtPos=AT(["],lcControlName)
  393.                 lnAtPos2=AT(['],lcControlName)
  394.                 lnAtPos=IIF(lnAtPos2=0 OR BETWEEN(lnAtPos,1,lnAtPos2),lnAtPos,lnAtPos2)
  395.                 lnAtPos2=AT([ ],lcControlName)
  396.                 lnAtPos=IIF(lnAtPos2=0 OR BETWEEN(lnAtPos,1,lnAtPos2),lnAtPos,lnAtPos2)
  397.                 lnAtPos2=AT([,],lcControlName)
  398.                 lnAtPos=IIF(lnAtPos2=0 OR BETWEEN(lnAtPos,1,lnAtPos2),lnAtPos,lnAtPos2)
  399.                 IF lnAtPos>0
  400.                     lcControlName=ALLTRIM(LEFT(lcControlName,lnAtPos-1))
  401.                 ENDIF
  402.             ENDIF
  403.             IF llInputTag AND ATC("TYPE=",lcClauses)=0 AND ATC("TYPE =",lcClauses)=0
  404.                 lcClauses=lcClauses+[ TYPE="]+IIF(m.lcVarType=="L",[CHECKBOX],[TEXT])+["]
  405.             ENDIF
  406.             lcSize=""
  407.             llAddSize=(llInputTag AND ATC("SIZE=",lcClauses)=0 AND ATC("SIZE =",lcClauses)=0)
  408.             llCheckBox=(m.lcVarType=="L")
  409.             lcHTMLControlSource=[oTHIS.document.script.]+lcControlName+IIF(llCheckBox,[.Checked],[.Value])
  410.             IF EMPTY(lcEvent)
  411.                 lcEvent=IIF(llCheckBox,"OnClick","OnChange")
  412.             ENDIF
  413.             lcFunction=""
  414.             IF NOT lcEvent=="-"
  415.                 lcFunction=lcControlName+"_"+lcEvent
  416.                 pcAppendSourceText=pcAppendSourceText+CR_LF+VBS_SCRIPT_START+CR_LF+ ;
  417.                         VBS_FUNCTION_START+" "+lcFunction+CR_LF
  418.                 pcAppendSourceText=pcAppendSourceText+[Navigate "vfps:RunScript?]+ ;
  419.                         lcFunction+["]+CR_LF
  420.             ENDIF
  421.             DO CASE
  422.                 CASE llCheckBox
  423.                     =.F.
  424.                 CASE m.lcVarType=="C" OR m.lcVarType=="M"
  425.                     IF llAddSize
  426.                         lcSize=ALLTRIM(STR(LEN(m.lcEvalStr)))
  427.                     ENDIF
  428.                 CASE m.lcVarType=="N"
  429.                     IF llAddSize
  430.                         lcSize=ALLTRIM(STR(LEN(ALLTRIM(STR(m.lcEvalStr)))))
  431.                     ENDIF
  432.                 CASE m.lcVarType=="D"
  433.                     IF llAddSize
  434.                         lcSize=ALLTRIM(STR(LEN(DTOC(m.lcEvalStr))))
  435.                     ENDIF
  436.                 CASE m.lcVarType=="T"
  437.                     IF llAddSize
  438.                         lcSize=ALLTRIM(STR(LEN(TTOC(m.lcEvalStr))))
  439.                     ENDIF
  440.             ENDCASE
  441.             IF NOT EMPTY(lcFunction)
  442.                 pcAppendSourceText=pcAppendSourceText+VBS_FUNCTION_END+CR_LF+ ;
  443.                         SCRIPT_END+CR_LF+CR_LF
  444.             ENDIF
  445.             pcAppendSourceText=pcAppendSourceText+VFPS_SCRIPT_START+CR_LF+ ;
  446.                     VFPS_FUNCTION_START+" "+lcFunction+CR_LF
  447.             DO CASE
  448.                 CASE m.lcVarType=="C" OR m.lcVarType=="L"
  449.                     lcDataValue=lcHTMLControlSource
  450.                 CASE m.lcVarType=="N"
  451.                     lcDataValue=[VAL(]+lcHTMLControlSource+[)]
  452.                 CASE m.lcVarType=="D"
  453.                     lcDataValue=[CTOD(]+lcHTMLControlSource+[)]
  454.                 CASE m.lcVarType=="T"
  455.                     lcDataValue=[CTOT(]+lcHTMLControlSource+[)]
  456.                 OTHERWISE
  457.                     lcDataValue=lcHTMLControlSource
  458.             ENDCASE
  459.             lcVFPCode=""
  460.             IF NOT EMPTY(lcCode)
  461.                 IF NOT RIGHT(lcCode,2)==CR_LF
  462.                     lcCode=lcCode+CR_LF
  463.                 ENDIF
  464.                 lcVFPCode=lcCode
  465.             ENDIF
  466.             IF NOT EMPTY(lcAlias) AND USED(lcAlias)
  467.                 IF EMPTY(lcMemVar)
  468.                     lcVFPCode=[REPLACE ]+lcControlSource+[ WITH ]+lcDataValue+CR_LF+lcVFPCode
  469.                 ELSE
  470.                     lcVFPCode=lcMemVar+[=]+lcDataValue+CR_LF+lcVFPCode
  471.                 ENDIF
  472.                 lcVFPCode=[SET DATASESSION TO (oTHIS.nDataSessionID)]+CR_LF+ ;
  473.                         [pnLastSelectTmp0=SELECT()]+CR_LF+ ;
  474.                         [SELECT ]+lcAlias+CR_LF+ ;
  475.                         [GO ]+lcRecNo+CR_LF+lcVFPCode+ ;
  476.                         [SELECT (pnLastSelectTmp0)]+CR_LF+ ;
  477.                         [SET DATASESSION TO (oTHIS.oHost.DataSessionID)]+CR_LF
  478.             ELSE
  479.                 lcVFPCode=IIF(EMPTY(lcMemVar),lcControlSource,lcMemVar)+[=]+lcDataValue+CR_LF+lcVFPCode
  480.             ENDIF
  481.             pcAppendSourceText=pcAppendSourceText+lcVFPCode
  482.             IF NOT EMPTY(lcRecNo)
  483.                 pcRefreshData=pcRefreshData+[GO ]+lcRecNo+[ IN ]+lcAlias+CR_LF
  484.             ENDIF
  485.             pcRefreshData=pcRefreshData+lcHTMLControlSource+[=]+lcControlSource+CR_LF
  486.             IF NOT EMPTY(lcFunction)
  487.                 pcRefreshSource=pcRefreshSource+[oTHIS.RunScript("]+lcFunction+[")]+CR_LF
  488.             ENDIF
  489.             pcAppendSourceText=pcAppendSourceText+VFPS_FUNCTION_END+CR_LF+ ;
  490.                     SCRIPT_END+CR_LF
  491.             DO CASE
  492.                 CASE NOT llInputTag
  493.                     =.F.
  494.                 CASE m.lcVarType=="C"
  495.                     m.lcEvalStr=[VALUE="]+m.lcEvalStr+["]
  496.                 CASE m.lcVarType=="N"
  497.                     m.lcEvalStr=ALLTRIM(STR(m.lcEvalStr,24,12))
  498.                     DO WHILE RIGHT(m.lcEvalStr,1)=="0"
  499.                         m.lcEvalStr=LEFT(m.lcEvalStr,LEN(m.lcEvalStr)-1)
  500.                         IF RIGHT(m.lcEvalStr,1)=="."
  501.                             m.lcEvalStr=LEFT(m.lcEvalStr,LEN(m.lcEvalStr)-1)
  502.                             EXIT
  503.                         ENDIF
  504.                     ENDDO
  505.                     m.lcEvalStr=[VALUE=]+m.lcEvalStr
  506.                 CASE m.lcVarType=="D"
  507.                     m.lcEvalStr=[VALUE="]+DTOC(m.lcEvalStr)+["]
  508.                 CASE m.lcVarType=="T"
  509.                     m.lcEvalStr=[VALUE="]+TTOC(m.lcEvalStr)+["]
  510.                 CASE m.lcVarType=="L"
  511.                     m.lcEvalStr=IIF(m.lcEvalStr,"CHECKED","")
  512.                 OTHERWISE
  513.                     m.lcEvalStr=""
  514.             ENDCASE
  515.             IF llAddSize AND NOT EMPTY(lcSize)
  516.                 lcClauses=lcClauses+[ SIZE=]+lcSize
  517.             ENDIF
  518.             lcInputTag=[<]+ALLTRIM(lcClauses+[ ]+m.lcEvalStr)+[>]
  519.             IF m.lcVarType=="L"
  520.                 lcInputTag=lcInputTag+lcLabel
  521.             ELSE
  522.                 lcInputTag=lcLabel+lcInputTag
  523.             ENDIF
  524.             m.lcEvalStr=lcInputTag
  525.         OTHERWISE
  526.             m.lcEvalStr=EVALUATE(m.lcEvalStr) &&;
  527.             Error occured during evaluation of {{ <expC> }}.
  528.     ENDCASE
  529.     m.lcVarType=TYPE("m.lcEvalStr")
  530.     DO CASE
  531.         CASE m.lcVarType=="C"
  532.             m.lcNewStr=m.lcEvalStr
  533.         CASE m.lcVarType=="N"
  534.             m.lcNewStr=ALLTRIM(STR(m.lcEvalStr,24,12))
  535.             DO WHILE RIGHT(m.lcNewStr,1)=="0"
  536.                 m.lcNewStr=LEFT(m.lcNewStr,LEN(m.lcNewStr)-1)
  537.                 IF RIGHT(m.lcNewStr,1)=="."
  538.                     m.lcNewStr=LEFT(m.lcNewStr,LEN(m.lcNewStr)-1)
  539.                     EXIT
  540.                 ENDIF
  541.             ENDDO
  542.         CASE m.lcVarType=="D"
  543.             m.lcNewStr=DTOC(m.lcEvalStr)
  544.         CASE m.lcVarType=="T"
  545.             m.lcNewStr=TTOC(m.lcEvalStr)
  546.         CASE m.lcVarType=="L"
  547.             m.lcNewStr=IIF(m.lcEvalStr,".T.",".F.")
  548.         OTHERWISE
  549.             m.lcNewStr=m.lcOldStr
  550.     ENDCASE
  551.     m.lcNewText=STRTRAN(m.lcNewText,m.lcOldStr,m.lcNewStr)
  552.     m.lnAtPos2=m.lnAtPos+LEN(m.lcNewStr)
  553.     IF m.lnAtPos2<=0
  554.         EXIT
  555.     ENDIF
  556.     m.lnAtPos3=m.lnAtPos3+m.lnAtPos2
  557. ENDDO
  558. lnCount2=0
  559. DO WHILE "{{"$m.lcNewText AND "}}"$m.lcNewText
  560.     lnCount=LEN(m.lcNewText)
  561.     m.lcNewText=EvlTxt(m.lcNewText)
  562.     IF lnCount=LEN(m.lcNewText)
  563.         IF lnCount2>=2
  564.             EXIT
  565.         ENDIF
  566.         lnCount2=lnCount2+1
  567.     ENDIF
  568. ENDDO
  569. RETURN m.lcNewText
  570.  
  571.  
  572.  
  573. FUNCTION InsFile(tcFileName)
  574. LOCAL lcFileStr,lnLastSelect,lcAlias
  575.  
  576. IF TYPE("m.tcFileName")#"C" OR NOT FILE(m.tcFileName)
  577.     RETURN ""
  578. ENDIF
  579. m.lnLastSelect=SELECT()
  580. m.lcAlias=LOWER(SYS(2015))
  581. IF USED(m.lcAlias)
  582.     SELECT (m.lcAlias)
  583.     LOCATE
  584. ELSE
  585.     CREATE CURSOR (m.lcAlias) (FILEINFO M)
  586.     SELECT (m.lcAlias)
  587.     INSERT BLANK
  588. ENDIF
  589. APPEND MEMO FILEINFO FROM (m.tcFileName) OVERWRITE
  590. lcFileStr=FILEINFO
  591. USE IN (m.lcAlias)
  592. SELECT (m.lnLastSelect)
  593. RETURN lcFileStr
  594.  
  595.  
  596.  
  597. FUNCTION StrTranC(ExpC1,ExpC2,ExpC3,ExpN1,ExpN2)
  598. LOCAL lcExpr,lnAtPos,lnAtPos2,lnCount,lnCount2
  599.  
  600. IF EMPTY(m.ExpC1) OR EMPTY(m.ExpC2)
  601.     RETURN m.ExpC1
  602. ENDIF
  603. lcExpr=m.ExpC1
  604. IF TYPE("m.ExpN1")#"N"
  605.     m.ExpN1=1
  606. ENDIF
  607. IF TYPE("m.ExpN2")#"N"
  608.     m.ExpN2=LEN(m.ExpC1)
  609. ENDIF
  610. IF m.ExpN1<1 OR m.ExpN2<1
  611.     RETURN m.ExpC1
  612. ENDIF
  613. m.lnCount=0
  614. m.lnCount2=0
  615. m.lnAtPos2=1
  616. DO WHILE .T.
  617.     m.lnAtPos=ATC(m.ExpC2,SUBSTR(lcExpr,m.lnAtPos2))
  618.     IF m.lnAtPos=0
  619.         EXIT
  620.     ENDIF
  621.     m.lnCount=m.lnCount+1
  622.     IF m.lnCount<m.ExpN1
  623.         m.lnAtPos2=m.lnAtPos+m.lnAtPos2+LEN(m.ExpC2)-1
  624.         LOOP
  625.     ENDIF
  626.     lcExpr=LEFT(lcExpr,m.lnAtPos+m.lnAtPos2-2)+m.ExpC3+;
  627.             SUBSTR(lcExpr,m.lnAtPos+m.lnAtPos2+LEN(m.ExpC2)-1)
  628.     m.lnCount2=m.lnCount2+1
  629.     IF m.lnCount2>=m.ExpN2
  630.         EXIT
  631.     ENDIF
  632.     m.lnAtPos2=m.lnAtPos+m.lnAtPos2+LEN(m.ExpC3)-1
  633.     IF m.lnAtPos2>LEN(lcExpr)
  634.         EXIT
  635.     ENDIF
  636. ENDDO
  637. RETURN lcExpr
  638.  
  639.  
  640.  
  641. FUNCTION VTOC(tcEvalStr)
  642. LOCAL lcNewStr,lcVarType
  643.  
  644. IF PARAMETERS()=0
  645.     RETURN ""
  646. ENDIF
  647. IF ISNULL(tcEvalStr)
  648.     RETURN ".NULL."
  649. ENDIF
  650. lcVarType=TYPE("tcEvalStr")
  651. DO CASE
  652.     CASE INLIST(lcVarType,"U","O")
  653.         RETURN ""
  654.     CASE lcVarType=="C"
  655.         lcNewStr=tcEvalStr
  656.     CASE lcVarType=="N"
  657.         lcNewStr=ALLTRIM(STR(tcEvalStr,24,12))
  658.         DO WHILE RIGHT(lcNewStr,1)=="0"
  659.             lcNewStr=LEFT(lcNewStr,LEN(lcNewStr)-1)
  660.             IF RIGHT(lcNewStr,1)=="."
  661.                 lcNewStr=LEFT(lcNewStr,LEN(lcNewStr)-1)
  662.             EXIT
  663.             ENDIF
  664.         ENDDO
  665.     CASE lcVarType=="D"
  666.         lcNewStr=DTOC(tcEvalStr)
  667.     CASE lcVarType=="T"
  668.         lcNewStr=TTOC(tcEvalStr)
  669.     CASE lcVarType=="L"
  670.         lcNewStr=IIF(tcEvalStr,".T.",".F.")
  671.     OTHERWISE
  672.         lcNewStr=""
  673. ENDCASE
  674. RETURN lcNewStr
  675.